30 Day Map Challenge 2024
Aki Di Sandro
2024-12-31
Map 1
Day 2 – Lines: Philly Bike Lanes
I decided to simplify the categories of Philadelphia’s streets that were available in the dataset to 4 categories: bike friendly, shared, bike lanes, and buffered bike lanes.
# philly crs
crs_philly <- 'EPSG:2272' # EPSG:2272 - NAD83 / Pennsylvania South (ftUS)
bikes <- st_read("../data/day02_data/PhiladelphiaBikeNetwork_SupportingDatasets201209/BikeNetwork_SupportingDatasets201209/PhiladelphiaBikeConnectorStreets201204.shp")
# source: https://opendataphilly.org/datasets/hydrology/
hydro <- st_read("https://services.arcgis.com/fLeGjb7u4uXqeF9q/arcgis/rest/services/Hydrographic_Features_Poly/FeatureServer/1/query?outFields=*&where=1%3D1&f=geojson") %>%
st_transform(crs = crs_philly)
# loading geometries of counties surrounding philly for basemap
nj_tracts <- get_acs(geography = "county",
variables = "B01001_001",
year = 2022,
state = 34,
county = c(5, 7, 15),
geometry = T) %>%
st_transform(crs = crs_philly)
pa_tracts <- get_acs(geography = "county",
variables = "B01001_001",
year = 2022,
state = 42,
county = c(17, 45, 91, 101),
geometry = T) %>%
st_transform(crs = crs_philly)
bikes_simplified <- bikes %>%
mutate(friendly = case_when(RecFacil %in% c("Bike Friendly Street", "Climbing Lane", "Cycletrack", "Contraflow") ~ "Bike Friendly Street",
RecFacil == "Buffered Bike Lane" ~ "Buffered Bike Lane",
grepl("Shared", RecFacil) ~ "Shared Lane",
grepl("^Bike Lane", RecFacil) ~ "Bike Lane",
.default = NA)) %>%
filter(!is.na(friendly))
street_colors <- c("Bike Friendly Street" = "#DCCA2CFF",
"Shared Lane" = "coral",
"Bike Lane" = "#0E84B4FF",
"Buffered Bike Lane" = "#58A449FF")
bikefriendly <- "#DCCA2CFF"
shared <- "coral"
bikelane <- "#0E84B4FF"
buffered <- "#58A449ff"
# annotation
text_description <- glue("Most streets are <span style='color:{bikefriendly};'>**bike friendly**</span> or <span style='color:{shared};'>**shared**</span> between autos\n
and bikes. There are also several streets with <span style='color:{bikelane};'>**bike lanes**</span>\n
and very few thaat have <span style='color:{buffered};'>**buffered bike lanes**</span>. As a\n
Philadelphian who frequently bikes, I can say that this dataset\n
needs to be updated!")
# Create map
bike_streets <- ggplot() +
# add surrounding counties
geom_sf(data = nj_tracts, fill = "darkgrey", color = "lightgrey") +
geom_sf(data = pa_tracts, fill = "darkgrey", color = "lightgrey") +
# map of philadelphia county
geom_sf(data = pa_tracts %>%
filter(GEOID == "42101"),
fill = "#555555", color = "lightgrey") +
# add hydrology
geom_sf(data = hydro, fill = "#96dbe3", color = "transparent") +
# add cora-colored border to emphasize the regions with highest and lowest voter turnout
geom_sf(data = bikes_simplified, aes(color = friendly), show.legend = F) +
# define custom color palette
scale_color_manual(values = street_colors) +
# map limits
coord_sf(xlim = c(2660000, 2749276),
ylim = c(208915, 310000)) +
# add title and subtitle
labs(title = "Which Philadelphia Streets are Bike Friendly?",
caption = "
30-Day Map Challenge\n
Day 2: Lines\n
Author: Akira Di Sandro\n
Source: OpenDataPhilly (Sep. 2012)\n
R Packages used: tidyverse, sf, tidycensus, ggtext, glue"
) +
# add annotations + label
geom_richtext(aes(x = 2705000, y = 228000, label = text_description),
size = 7/.pt, lineheight = 0.5, color = "black", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
# define map theme
theme_void() +
theme(plot.title = element_text(face = "bold",
size = 18,
margin = margin(5, 0, -45, 10),
hjust = 0,
family = "AppleGothic"),
plot.caption = element_text(face = "italic",
size = 5,
hjust = 1,
margin = margin(-40, 5, 0, 0),
lineheight = 0.5,
family = "AppleGothic")
)bike_streets
Map 2
Day 3 – Polygons: Philadelphia Political Wards and Voter Turnout in the 2020 General Election
Since we were so close to Election Day, I decided to map out the different Political wards in Philadelphia and color them with voter turnout from the 2020 General Election, highlighting the two wards with the highest and lowest voter turnout.
# source: https://opendataphilly.org/datasets/political-wards/
philly_pol_wards <- st_read("https://opendata.arcgis.com/datasets/d67c97376d18456d98e5fa6e00415ad4_0.geojson") %>%
st_transform(crs = crs_philly)
# source: https://opendataphilly.org/datasets/voter-turnout/
voter_turnout <- read.csv("../data/day03_data/election_turnout_ward.csv")
# filter voter_turnout to keep data from the 2020 General Election
voter_turnout_20 <- voter_turnout %>%
filter(election_name == "2020 General")
# join voter_turnout_20 to philly_pol_wards
to_map <- left_join(philly_pol_wards %>%
mutate(ward = as.numeric(WARD_NUM)),
voter_turnout_20,
by = "ward")
# define colors for the annotations
lightgreen <- "#9ec799"
darkgreen <- "#093d02"
# annotations
annotation_lowest <- glue("
**Lowest Voter Turnout**:\n
Ward 27, 39.9%")
annotation_highest <- glue("
**Highest Voter Turnout**:\n
Ward 9, 80.1%")
annotation_subtitle <- glue("Colored by **Voter Turnout** at the 2020 General Election\n
ranging from <span style='color:{lightgreen};'>**39.9%**</span> to <span style='color:{darkgreen};'>**80.1%**</span>.")
# Create map
philly_ward_map <- ggplot() +
# add surrounding counties
geom_sf(data = nj_tracts, fill = "#555555", color = "lightgrey") +
geom_sf(data = pa_tracts, fill = "#555555", color = "lightgrey") +
# main data to plot
geom_sf(data = to_map, aes(fill = turnout), color = "transparent") +
# add hydrology
geom_sf(data = hydro, fill = "#96dbe3", color = "transparent") +
# add cora-colored border to emphasize the regions with highest and lowest voter turnout
geom_sf(data = to_map %>%
filter(turnout == .399 | turnout == .801),
fill = "transparent", color = "coral") +
# define custom color palette
scale_fill_gradient(low = "#9ec799",
high = "#093d02") +
# map limits
coord_sf(xlim = c(2630000, 2749276),
ylim = c(208915, 330000)) +
# add title and subtitle
labs(title = "Philadelphia County Political Wards",
caption = "
30-Day Map Challenge\n
Day 3: Polygons\n
Author: Akira Di Sandro\n
Source: OpenDataPhilly\n
R Packages used: tidyverse, sf, tidycensus, ggtext, glue"
) +
# add annotations + label
geom_richtext(aes(x = 2641928, y = 233598, label = annotation_lowest),
size = 5/.pt, lineheight = 0.5, color = "#9ec799", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = 2683674, y = 295230, label = annotation_highest),
size = 5/.pt, lineheight = 0.5, color = "#093d02", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = 2633578, y = 308204, label = annotation_subtitle),
size = 10/.pt, lineheight = 0.5, color = "black", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
# add lines to annotations
geom_segment(aes(x = 2662920, xend = 2680096, y = 233598, yend = 234598), color = "coral", size = 0.3) +
geom_segment(aes(x = 2676518, xend = 2683078, y = 285198, yend = 295230), color = "coral", size = 0.3) +
# define map theme
theme_void() +
theme(plot.title = element_text(face = "bold",
size = 20,
margin = margin(10, 0, -50, 10),
hjust = 0,
family = "AppleGothic"),
legend.position = "none",
plot.caption = element_text(face = "italic",
size = 5,
hjust = 1,
margin = margin(-40, 20, 0, 0),
lineheight = 0.5,
family = "AppleGothic"),
plot.background = element_rect(fill = "#555555"),
panel.background = element_rect(fill = "#555555"),
plot.margin = margin(0, 0, 0, 0)
)philly_ward_map
Map 3
Day 5 – Journey: My Winter Vacation, 2023-2024
For this challenge, I mapped out my super complicated winter vacation from Dec 2023 - Jan 2024. My dad works for United, which means that until I turn 26, I can fly for free (on United flights) on “standby” as long as there are available seats on a plane. This allowed me to make many stops to see different friends throughout Asia and Australia this winter.
Each shape corresponds to who I was traveling with (circle: by myself, triangle: family, diamond: friends), the size of the city name corresponds to how long I stayed in each city (ranging from a quick layover, to a 5-day stay), and each band representing flights has a thickness that corresponds to the length of the flight itself.
# airports i care about
airport_codes <- c("PHL", "ORD", "NRT", "CGK", "YIA", "DPS", "MNL", "BNE", "SFO")
# make sure typo is fixed in airports
my_airports <- airports %>%
rename(Longitude = Longtitude) %>%
dplyr::select(IATA, City, Latitude, Longitude) %>%
filter(IATA %in% airport_codes) %>%
rbind(data.frame(IATA = "YIA", # add YIA since it's missing from this dataset
City = "Yogyakarta",
Latitude = -7.8746,
Longitude = 110.1087)) %>%
mutate(lon = Longitude + 360*(Longitude < 0),
code = factor(IATA, levels = airport_codes)) %>%
arrange(code) %>%
mutate(
# who was i with in this location?
companion = c("self", "family", "self", "self", "friends", "friends", "self", "friends", "self"),
# how long did I spend at this location? (in days)
duration = c(99, 4, .1, .3, 2, 2, .85, 5, .1),
# how long was the flight itself?
flight_dur = c(2.33, 13.5, 8, 1.25, 1.67, 4.1, 7.75, 13.15, 5.25),
# which leg of my trip was it?
leg = c("trip1", rep("trip2", 3), "trip3", "trip4", "trip5", rep("trip6", 2)),
# defining the shape of the airport marker depending on who i was with;
shape = case_when(companion == "family" ~ 17, # triangle if with family
companion == "friends" ~ 18, # diamond if with friends
.default = 20), # circle if alone
# adjust text size according to my duration of stay in each location;
textsize = case_when(duration <= .5 ~ 3, # 1 if i was there less than half of the day
duration <= 1 ~ 3.5, # 1.2 if i was there for more than half the day but no more than one whole day
duration <= 2 ~ 4, # 1.4 if i was there for more than 1 day but no more than two days
.default = 4.5), # 1.6 if i was there for more than 2 days
# adjust flight color depending on leg of trip
# flight_col = case_when(leg == "trip1" ~ "darkred",
# leg == "trip2" ~ "coral3",
# leg == "trip3" ~ "darkred",
# leg == "trip4" ~ "coral3",
# leg == "trip5" ~ "darkred",
# leg == "trip6" ~ "coral3"),
# adjust size of flight according to actual length of flight
flight_size = case_when(flight_dur <= 5 ~ .3,
flight_dur <= 10 ~ .5,
.default = .7),
# specify location of text labels (specifically wanted to move Chicago and SF)
text_lat = case_when(City == "Chicago" ~ Latitude + 1.75,
City == "San Francisco" ~ Latitude - 7,
City == "Brisbane" ~ Latitude - 4,
City == "Tokyo" ~ Latitude - 2,
City == "Manila" ~ Latitude + 1.7,
City == "Yogyakarta" ~ Latitude - 1.7,
.default = Latitude),
text_lon = case_when(City == "Chicago" ~ lon + 5,
City == "Tokyo" ~ lon + 3,
City == "Manila" ~ lon + 4,
City == "Jakarta" ~ lon - 3,
City == "Depansar" ~ lon + 7,
City == "Yogyakarta" ~ lon - 5,
.default = lon)
)
# define flights
my_trips <- data.frame(Departure = c("PHL", "ORD", "NRT", "CGK", "YIA", "DPS", "MNL", "BNE", "SFO"),
Arrival = c("ORD", "NRT", "CGK", "YIA", "DPS", "MNL", "BNE", "SFO", "PHL"),
dep_lon = my_airports$lon,
dep_lat = my_airports$Latitude,
arr_lon = c(my_airports$lon[-1], my_airports$lon[1]),
arr_lat = c(my_airports$Latitude[-1], my_airports$Latitude[1]))
# defining my routes
my_routes <- my_trips %>%
dplyr::select(-c(Departure, Arrival)) %>%
cbind(my_airports %>%
dplyr::select(
# flight_col,
flight_size))
# adjust direction
around <- ((pmax(my_routes$dep_lon, my_routes$arr_lon) > 300 &
pmin(my_routes$dep_lon, my_routes$arr_lon) < 160) |
(pmax(my_routes$dep_lon, my_routes$arr_lon) > 200 &
pmin(my_routes$dep_lon, my_routes$arr_lon) < 60))
westbound <- (my_routes$arr_lon < my_routes$dep_lon) # Westbound flights
AdjustDirection <- (westbound != around)
my_routes$dep_lat[AdjustDirection] <- my_trips$arr_lat[AdjustDirection]
my_routes$dep_lon[AdjustDirection] <- my_trips$arr_lon[AdjustDirection]
my_routes$arr_lat[AdjustDirection] <- my_trips$dep_lat[AdjustDirection]
my_routes$arr_lon[AdjustDirection] <- my_trips$dep_lon[AdjustDirection]
# create map
# base map
worldmap <- borders("world2", colour="cornsilk", fill="cornsilk")
my_journey <- ggplot() +
worldmap +
theme_void() +
geom_curve(data = my_routes, aes(x = dep_lon, y = dep_lat, xend = arr_lon, yend = arr_lat,
# col = flight_col,
size = flight_size),
col = "darkred",
curvature = -.3) +
scale_color_identity() +
scale_size_identity() +
geom_point(data = my_airports, aes(x = lon, y = Latitude, shape = shape),
col = "coral") +
scale_shape_identity() +
geom_text_repel(data = my_airports,
aes(x = text_lon, y = text_lat, label = City, size = textsize),
col = "coral", segment.color = NA, box.padding = .1, point.padding = .1,
xlim = c(0,360),
family = "AppleGothic",
fontface = "bold"
) +
labs(title = "Mapping Out My Winter Vacation\nfrom Dec '22 to Jan '23",
caption =
"30-Day Map Challenge\n
Day 5: A Journey\n
Author: Akira Di Sandro\n
R Packages used: tidyverse, ggrepel, maps, flightplot"
) +
theme(
plot.title = element_text(face = "bold",
size = 12,
margin = margin(60, 0, -100, 65),
hjust = 0,
color = "coral",
family = "AppleGothic"),
plot.caption = element_text(face = "italic",
size = 5,
hjust = 1,
color = "coral",
margin = margin(-60, 30, 0, 0),
lineheight = 0.5,
family = "AppleGothic"),
panel.background = element_rect(fill = "darkslategrey"),
plot.background = element_rect(fill = "darkslategrey"),
plot.margin = margin(0, 0, 0, 0)
)my_journey
Map 4
Day 8 – HDX: DRC Health zones and Poltical Violence Events
For the Humanitarian Data Exchange theme, I decided to look into the count of Healthzones (clinics and hospitals) in the Democratic Republic of Congo on a bivariate map with count of Political Violence Events in 2023 to highlight areas that have adequate and inadequate amount of healthzones compared to how much violence people face in each province.
# DRC CRS (UTM Zone 34S)
DRC_CRS <- 32734
# shp file of all health zones in DRC
# source: https://data.humdata.org/dataset/dr-congo-health-0
DRC_healthzones <- st_read("../data/day08_data/rdc_zone_de_sante_09092019/RDC_Zone_de_sante_09092019.shx") %>%
st_transform(crs = DRC_CRS)
# DRC political violence count
# source: https://data.humdata.org/dataset/democratic-republic-of-congo-acled-conflict-data
DRC_pol_vio <- readxl::read_xlsx("../data/day08_data/democratic-republic-of-congo_hrp_political_violence_events_and_fatalities_by_month-year_as-of-0.xlsx",
sheet = 2)
# download shape file for DRC provinces
# source: https://datacatalog.worldbank.org/search/dataset/0040240/Democratic-Republic-of-the-Congo---Administrative-Boundaries
DRC_provinces <- st_read("https://datacatalogfiles.worldbank.org/ddh-published/0040240/DR0050122/codadmbndaadm120170407.geojson?versionId=2023-01-19T05:05:08.3848692Z") %>%
st_transform(crs = DRC_CRS)
# get DRC's surrounding countries
world <- ne_countries(scale = "medium", returnclass = "sf")
background_countries <- world %>%
filter(name %in% c("Angola", "Burundi", "Cameroon", "Central African Rep.", "Chad", "Ethiopia", "Eq. Guinea", "Gabon", "Congo", "Kenya", "Malawi", "Mozambique", "Nigeria", "Rwanda", "S. Sudan", "Tanzania", "Uganda", "Zambia")) %>%
st_transform(crs = DRC_CRS)
rm(world)
# one big polygon of drc
DRC_bounds <- DRC_provinces %>%
st_union()
# rename provinces to match the other dataframes
DRC_PV <- DRC_pol_vio %>%
mutate(PROVINCE = case_when(Admin1 == "Kasai" ~ "Kasaï",
Admin1 == "Kasai-Central" ~ "Kasaï-Central",
Admin1 == "Kasai-Oriental" ~ "Kasaï-Oriental",
Admin1 == "Mai-Ndombe" ~ "Maï-Ndombe",
.default = Admin1))
# function to turn coordx and coordy into point geometry
coord_to_pointgeo <- function(coord_col) {
# separate coord_col into its separate components
separated <- stringr::str_match(coord_col, "(\\d+)° (\\d+)' (\\d+\\,?\\d*)\" ([NSEW])")
degrees <- as.numeric(separated[, 2])
minutes <- as.numeric(separated[, 3])
seconds <- as.numeric(sub(",",".", separated[, 4]))
direction <- separated[, 5]
decimal_degrees <- degrees + minutes / 60 + seconds / 3600
ifelse(direction %in% c("S", "W"), -decimal_degrees, decimal_degrees)
}
# DRC healthzones with mappable point geometries and adding territory data
DRC_HZ_points <- DRC_healthzones %>%
st_drop_geometry() %>%
mutate(lon = coord_to_pointgeo(coordx),
lat = coord_to_pointgeo(coordy)) %>%
st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
st_transform(crs = DRC_CRS) %>%
dplyr::select(OBJECTID,ID,PROVINCE,Nom,Population,coordx:geometry)
# add column for area (in km^2) for each province
DRC_provinces$area_province <- as.numeric(st_area(DRC_provinces)) / 1e6
# total count of healthzones by province
DRC_HZ_prov <- DRC_healthzones %>%
st_drop_geometry() %>%
group_by(PROVINCE) %>%
summarise(HZ_count = n()) %>%
left_join(DRC_provinces %>%
dplyr::select(NOM,area_province) %>%
rename(PROVINCE = NOM),
by = "PROVINCE") %>%
mutate(HZ_per_sqkm = HZ_count / area_province) %>%
st_as_sf()
# political violence fatalities in 2023
DRC_PV_2023 <- DRC_PV %>%
filter(Year == 2023) %>%
dplyr::select(PROVINCE, Events, Fatalities) %>%
group_by(PROVINCE) %>%
summarize(prov_total_events_2023 = sum(Events),
prov_total_fatals_2023 = sum(Fatalities)) %>%
ungroup()
# combine data of political violence with shp file of provinces
DRC_prov_tomap <- left_join(DRC_HZ_prov,
DRC_PV_2023, # look at raw count of PV events or fatalities instead
by = "PROVINCE")
# make bivariate classes for HZ count per sqkm and % change in PV event
DRC_prov_biclass <- bi_class(DRC_prov_tomap,
x = prov_total_events_2023,
y = HZ_per_sqkm,
style = "quantile", dim = 4) %>%
st_as_sf()
# prep for map
grey_color <- "#d3d3d3" # for 1-1
blue_color <- "#4279b0" # for highest class of HZ/sqkm
blue_1_3_color <- "#7397bb" # for 1-3
wine_color <- "#9e3547" # for highest class of prov_event_pctchange
purple_color <- "#311e3b" # for 4-4
# subtitle with color specification
annotation_subtitle <- glue("<span style='color:{blue_color};'>**Count of Healthzones (per sq km)**</span> and Count of<br><span style='color:{wine_color};'>**Political Violence (PV) Events**</span> in 2023")
# other plot annotations
annotation_1_1 <- glue(
"**Bas-Uele**:\n
4 reported events of PV\n
(3 reported fatalities)\n
11 healthzones"
)
annotation_1_3 <- glue(
"**Sud-Ubangi**:\n
3 reported events of PV\n
(2 reported fatalities)\n
16 healthzones"
)
annotation_4_1 <- glue(
"**Mai-Ndombe**:\n
31 reported events of PV\n
(93 reported fatalities)\n
14 healthzones"
)
annotation_4_4 <- glue(
"**Nord-Kivu**:\n
1,102 reported events of PV\n
(1,808 reported fatalities)\n
34 healthzones"
)
annotation_HZ <- glue(
"represents a healthzone"
)
# bivariate map of healthzone count per sq km and count of political violence events from 2023
map <-
ggplot() +
# add surrounding countries
geom_sf(data = background_countries,
fill = "#555555",
color = "lightgrey",
lwd = 0.5) +
# add map of the rest of the provinces with biclass coloring
geom_sf(data = DRC_prov_biclass,
aes(fill = bi_class),
color = "transparent",
show.legend = F) +
# add border around DRC
geom_sf(data = DRC_bounds,
fill = "transparent",
color = "lightgrey",
lwd = 0.5) +
# highlight the provinces with annotations in white
geom_sf(data = DRC_prov_biclass %>%
filter(PROVINCE %in% c("Bas-Uele","Sud-Ubangi","Maï-Ndombe","Nord-Kivu")),
fill = "transparent",
color = "white",
lwd = 1,
show.legend = F) +
# add points for healthzones
geom_sf(data = DRC_HZ_points, shape = 18, fill = "black") +
# add diamond for annotation
geom_point(aes(x = -497500, y = 10570000), shape = 18, fill = "black") +
# define color palette for biclass
bi_scale_fill(pal = "DkViolet2", dim = 4, flip_axes = FALSE, rotate_pal = FALSE) +
# map limits
coord_sf(xlim = c(-500000, 1820000),
ylim = c(8400000, 10800000)) +
# Add the colored annotations with leader lines
geom_richtext(aes(x = -497500, y = 10720000, label = annotation_subtitle),
color = "black", size = 10/.pt, lineheight = 0.5,
hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = -480000, y = 10570000, label = annotation_HZ),
color = "black", size = 8/.pt, lineheight = 0.5,
hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = 950000, y = 10685000, label = annotation_1_1),
color = grey_color, size = 5/.pt, lineheight = 0.5,
hjust = 0, family = "AppleGothic",
fill = alpha(grey_color, 0.2), label.color = NA) +
geom_richtext(aes(x = -200000, y = 10360000, label = annotation_1_3),
color = blue_1_3_color, size = 5/.pt, lineheight = 0.5,
hjust = 0, family = "AppleGothic",
fill = alpha(grey_color, 0.2), label.color = NA) +
geom_richtext(aes(x = -450000, y = 9730000, label = annotation_4_1),
color = wine_color, size = 5/.pt, lineheight = 0.5,
hjust = 0, family = "AppleGothic",
fill = alpha(grey_color, 0.2), label.color = NA) +
geom_richtext(aes(x = 1490000, y = 9900000, label = annotation_4_4),
color = purple_color, size = 5/.pt, lineheight = 0.5,
hjust = 0, family = "AppleGothic",
fill = alpha(grey_color, 0.2), label.color = NA) +
# Title and subtitle using ggtext for colored styling
labs(title = "Democratic Republic of Congo (DRC) Provinces",
caption = "
30-Day Map Challenge\n
Day 8: Humanitarian Data Exchange (HDX)\n
Author: Akira Di Sandro\n
Source: HDX, World Bank Group Data Catalog\n
R Packages used: tidyverse, sf, biscale, stringr, glue, ggtext, cowplot, rnaturalearth") +
# adjust theme
theme_void() +
theme(plot.title = element_text(face = "bold",
size = 20,
margin = margin(0, 0, -20, 10),
hjust = 0,
family = "AppleGothic"),
plot.caption = element_text(face = "italic",
size = 5,
hjust = 1,
margin = margin(-40, 20, 5, 0),
lineheight = 0.5,
family = "AppleGothic"),
plot.background = element_rect(fill = "#96dbe3"),
panel.background = element_rect(fill = "#96dbe3"))
# Legend
legend <- bi_legend(pal = "DkViolet2",
flip_axes = FALSE,
rotate_pal = FALSE,
dim = 4,
xlab = "% Change in PV events",
ylab = "Healthzone Count (per sq km)",
size = 10) +
theme(plot.background = element_rect(fill = "transparent"),
panel.background = element_rect(fill = "transparent"),
axis.title.x = element_text(size = 6,
family = "AppleGothic",
face = "bold"),
axis.title.y = element_text(size = 6,
family = "AppleGothic",
face = "bold"),
panel.grid.major = element_blank())
# Combine map and legend using cowplot
map_and_legend <- ggdraw() +
draw_plot(map, 0, 0, 1, 1) +
draw_plot(legend, 0.1, 0.1, 0.28, 0.28)map_and_legend
Map 5
Day 13 – New Tool: Share of Asian Philadelphians from 2012-2022
Some part of me had been refusing to make maps with anything other
than ggplot2 (what I’m used to), so for this “New Tool”
challenge, I challenged myself to create a map using the
tmap package. I decided to map out the share of Asian
Population in each census tract from 2012-2022 to highlight changes in
Asian Residential patterns in Philadelphia in this time period (code has
been commented out since the GIF takes a bit to create).
# loop to load tracts for 2012-2022
# for (yr in 12:22) {
# year <- as.numeric(paste0("20", yr))
# df_name <- paste0("tracts", yr)
#
# tracts <- get_acs(geography = "tract",
# variables = c("B01001_001E", # total population
# "B01001D_001E" # Asian population
# ),
# year = year,
# state = 42,
# county = 101,
# geometry = T,
# output = "wide") %>%
# st_transform(crs = crs_philly) %>%
# rename(TotalPop = B01001_001E,
# TotalAsianPop = B01001D_001E
# ) %>%
# dplyr::select(-ends_with("M", ignore.case = F)) %>%
# mutate(PctAsian = TotalAsianPop / TotalPop,
# year = year)
#
# assign(df_name, tracts)
# }
#
# pctAsian <- rbind(tracts12 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts13 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts14 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts15 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts16 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts17 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts18 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts19 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts20 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts21 %>%
# dplyr::select(GEOID, PctAsian, year),
#
# tracts22 %>%
# dplyr::select(GEOID, PctAsian, year))
#
# my_pal <- colorRampPalette(c("#180F3EFF", "#F1605DFF"))
#
# # custom breaks and labels for legend
# my_breaks <- c(0, 0.13, 0.26, 0.39, 0.53, 0.66)
# my_labels <- c("0%", "13%", "26%", "39%", "53%", "66%")
#
# pctAsian_tm_anim <- tm_shape(pctAsian) +
# tm_polygons(
# col = "PctAsian",
# style = "cont",
# pal = my_pal(100),
# breaks = my_breaks,
# labels = my_labels
# ) +
# tm_facets(by = "year",
# free.coords = F,
# ncol = 1,
# nrow = 1
# ) +
# tm_layout(legend.position = c("right","center"),
# bg.color = "#555555",
# title = "Share of Asian Population in Philadelphia, 2012-2022",
# title.position = c("center", "top"),
# title.color = "lightgrey",
# title.fontfamily = "AppleGothic",
# title.fontface = "bold",
# inner.margins = c(0.1, 0.1, 0.1, 0.1),
# legend.title.size = 1,
# legend.text.size = 0.6,
# legend.text.fontfamily = "AppleGothic",
# panel.show = T,
# panel.label.bg.color = "#555555",
# panel.label.fontfamily = "AppleGothic",
# panel.label.color = "lightgrey") +
# tm_credits(
# text = "30-Day Map Challenge\nDay 13: New Tool\nAuthor: Akira Di Sandro\nSource: ACS 2012-2022\nR Packages used: tidyverse, tidycensus, sf, tmap",
# position = c("right", "bottom"),
# size = 0.4,
# col = "lightgrey",
# fontfamily = "AppleGothic",
# fontface = "italic"
# ) +
# tm_shape(hydro) +
# tm_fill(
# col = "#96dbe3"
# )
GIF of Map 5
Map 6
Day 21 – Conflict: Palestine
With the ongoing genocide in Palestine, I wanted to showcase just how much Israel had caused since the conflict.
# crs for palestine
crs_palestine <- 'EPSG:28191'
# source: https://gaza-unosat.hub.arcgis.com/pages/data?preview=true
palestine <- st_read("../data/day21_data/UNOSAT_GazaStrip_CDA_06September2024.gdb") %>%
st_as_sf() %>%
st_transform(crs = crs_palestine)
# for base map
pal_basemap <- ne_countries(scale = "large",
country = c("Palestine", "Israel", "Egypt", "Lebanon")) %>%
st_transform(crs = crs_palestine)
# only keep data from latest sensor
pal_latest <- palestine %>%
dplyr::select(SensorDate_9:Shape)
# annotations
text_egy <- "Egypt"
text_isr <- "Israel"
text_pal <- "Gaza, Palestine"
col_low <- "#400603"
col_high <- "#fc1105"
text_caption <- glue("Since October 7th, 2023, Israel has relentlessly\n
and indiscriminantly bombarded the Gaza strip.\n
This map shows the severity of damages to\n
buildings in Gaza as a result of the ongoing\n
genocide (<span style='color:{col_low};'>**low**</span> to <span style='color:{col_high};'>**high**</span> levels of damage).")
# create map
pal_map <- ggplot() +
# add base map
geom_sf(data = pal_basemap, fill = "#555555", color = "lightgrey") +
# thicker line around gaza
geom_sf(data = pal_basemap %>%
filter(admin == "Palestine"), fill = "#555555", color = "lightgrey",
lwd = 1) +
# add points of damaged buildings
geom_sf(data = pal_latest, aes(color = Main_Damage_Site_Class_9),
alpha = 0.25,
show.legend = F) +
# set color and size
scale_color_gradient(low = "#400603",
high = "#fc1105") +
# map limits
coord_sf(xlim = c(65000, 110000),
ylim = c(62000, 125000)) +
# add title and subtitle
labs(title = "Building Damages in the Gaza Strip,\nSep. 2024",
caption = "
30-Day Map Challenge\n
Day 21: Conflict\n
Author: Akira Di Sandro\n
Source: UNOSTAT\n
R Packages used: tidyverse, sf, ggplot2, rnaturalearth, ggtext, glue"
) +
# add annotations + label
geom_richtext(aes(x = 68000, y = 65000, label = text_egy),
size = 10/.pt, lineheight = 0.5, color = "lightgrey", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = 82000, y = 90000, label = text_pal),
size = 10/.pt, lineheight = 0.5, color = "#555555", hjust = 1, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = 100000, y = 75000, label = text_isr),
size = 10/.pt, lineheight = 0.5, color = "lightgrey", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
geom_richtext(aes(x = 65000, y = 110000, label = text_caption),
size = 13/.pt, lineheight = 0.5, color = "black", hjust = 0, family = "AppleGothic",
fill = NA, label.color = NA) +
# define map theme
theme_void() +
theme(plot.title = element_text(face = "bold",
size = 20,
margin = margin(5, 0, -45, 5),
hjust = 0,
family = "AppleGothic"),
plot.caption = element_text(face = "italic",
size = 7,
hjust = 1,
margin = margin(-45, 5, 0, 0),
lineheight = 0.5,
family = "AppleGothic"),
panel.background = element_rect(fill = "#96dbe3"),
plot.margin = margin(0, 0, 0, 0)
)pal_map
Map 7
Day 22 – 2 Colors: States with Banned Access to Youth Gender-Affirming Care
For this theme I decided to highlight US States with policies and law limiting youth access to gender affirming care in red. The challenge for this map was to get Alaska and Hawaii on the right scale in the same map as the contiguous US. The formatting of the title was imperfect because of the method I chose.
# set CRS
crs_contUS <- 'ESRI:102004' # ESRI:102004 - USA_Contiguous_Lambert_Conformal_Conic
crs_alaska <- 'EPSG:3338'
crs_hawaii <- 'EPSG:4269'
# list of states where gender-affirming care is not available for trans youth
# source: https://www.kff.org/other/dashboard/gender-affirming-care-policy-tracker/
banned_care <- c("Alabama", "Arkansas", "Arizona", "Florida", "Georgia", "Iowa", "Idaho", "Indiana", "Kentucky", "Louisiana", "Missouri", "Mississippi", "Montana", "North Carolina", "New Hampshire", "North Dakota", "Nebraska", "Ohio", "Oklahoma", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "West Virginia", "Wyoming")
# US states
USA <- ne_states(country = "united states of america") %>%
mutate(affirming_care = ifelse(name %in% banned_care, 0, 1),
color = ifelse(affirming_care == 0, "red", "black"))
# contiguous states
USA_contig <- USA %>%
filter(!grepl("Alaska|Hawaii", name)) %>%
st_transform(crs = crs_contUS)
alaska <- USA %>%
filter(grepl("Alaska", name)) %>%
st_transform(crs = crs_alaska)
hawaii <- USA %>%
filter(grepl("Hawaii", name)) %>%
st_transform(crs = crs_hawaii)
# annotations
color_red <- "red"
text_title <- glue("<span style='color:{color_red};'>**Half of US States**</span> have Policies and Laws Limiting Access to Gender Affirming Care for Youth")
# create map
care_map1 <- ggplot() +
# add base map
geom_sf(data = USA_contig, aes(fill = color)) +
# set fill color
scale_fill_identity() +
# set map limits
coord_sf(xlim = c(-2361356, 2256078),
ylim = c(-1600266, 1721503)) +
# add title and subtitle
labs(caption = "
30-Day Map Challenge\n
Day 22: 2 Colors\n
Author: Akira Di Sandro\n
Source: KFF\n
R Packages used: tidyverse, sf, ggplot2, rnaturalearth, ggtext, glue, cowplot"
) +
# add annotations + label
geom_richtext(aes(x = -52639, y = 1700000, label = text_title),
size = 12/.pt, color = "black", hjust = 0.5, family = "AppleGothic",
fill = NA, label.color = NA) +
# define map theme
theme_void() +
theme(plot.caption = element_text(face = "italic",
size = 7,
hjust = 1,
margin = margin(-45, 5, 0, 0),
lineheight = 0.5,
family = "AppleGothic"),
panel.background = element_rect(fill = "white", color = "transparent")
)
care_map2 <- ggplot() +
# add base map for alaska
geom_sf(data = alaska, aes(fill = color)) +
# set fill color
scale_fill_identity() +
# set theme
theme_void()
care_map3 <- ggplot() +
# add base map for hawaii
geom_sf(data = hawaii, aes(fill = color)) +
# set fill color
scale_fill_identity() +
# set map limits
coord_sf(xlim = c(-161.3044, -154.8141),
ylim = c(18.90612, 22.20168)) +
# set theme
theme_void()
care_map <- ggdraw() +
draw_plot(care_map1, 0, 0, 1, 1) +
draw_plot(care_map2, 0, 0.1, 0.24, 0.24) +
draw_plot(care_map3, 0.25, 0.02, 0.15, 0.15)care_map
Map 8
Day 26 – Projections: World on the Van der Grinten Projection
For this theme, I simply display the world on the Van der Grinten Projection
# set CRS/projection
proj <- "+proj=vandg4" # igh, moll, wintri, robin, vandg4
# load world data
world <- ne_countries(scale = "medium",
returnclass = "sf") %>%
st_transform(crs = proj)
# create map
proj_map <- ggplot() +
# add base map
geom_sf(data = world, fill = "tan", color = "antiquewhite") +
# add title and subtitle
labs(title = "The World on the Van der Grinten Projection",
caption = "
30-Day Map Challenge\n
Day 26: Map Projections\n
Author: Akira Di Sandro\n
Source: Rnaturalearth\n
R Packages used: tidyverse, sf, ggplot2, rnaturalearth"
) +
# define map theme
theme_minimal() +
theme(plot.title = element_text(face = "bold",
size = 14,
hjust = 0.5,
margin = margin(0, 0, -5, 0),
family = "AppleGothic"),
plot.caption = element_text(face = "italic",
size = 7,
hjust = 1,
margin = margin(-45, 5, 0, 0),
lineheight = 0.5,
family = "AppleGothic"),
plot.background = element_rect(fill = "#96dbe3", color = "transparent")
)proj_map
Map 9
Day 28 – Blue Planet: Indigenous Americans around the Great Lakes
Growing up in the suburbs of Chicago, Lake Michigan was an oasis of cooling and fun times during the hot summer. Since this challenge was on Thanksgiving, I knew I wanted to do something with data on Indigenous Americans. I ended up plotting where some of the more prominenet Indigenous Americans in the Great Lakes are used to reside. This was a major challenge since there is limited and conflicting data on where different groups used to roam.
# set CRS for the great lakes
crs_greatlakes <- 'EPSG:3174'
# get data for US States that touch the Great Lakes
states <- ne_states(country = "united states of america",
returnclass = "sf") %>%
dplyr::select(adm1_code,name,postal) %>%
filter(grepl("IL|IN|WI|MI|MN|OH|PA|NY|IA", postal)) %>%
st_transform(crs = crs_greatlakes)
# get data for Canadian provinces
provinces <- ne_states(country = "canada",
returnclass = "sf") %>%
dplyr::select(adm1_code,name,postal) %>%
filter(grepl("ON|QC", postal)) %>%
st_transform(crs = crs_greatlakes)
# get Great Lakes data
# source: https://www.sciencebase.gov/catalog/item/530f8a0ee4b0e7e46bd300dd
great_lakes <- ne_download(scale = "large",
type = "lakes",
category = "physical",
returnclass = "sf") %>%
dplyr::select(name,name_alt) %>%
filter(grepl("Great Lakes", name_alt)) %>%
st_transform(crs = crs_greatlakes)
# tribes that surround the great lakes:
# references:
# https://www.eekwi.org/great-lakes/humans-and-great-lakes/native-peoples-great-lakes-region#:~:text=Notable%20tribes%20around%20the%20Great,%2C%20and%20Sioux%20(Lakota).
# https://kidsforward.org/wisconsins-native-communities/
# https://www.mpm.edu/content/wirp/ICW-21
# https://www.britannica.com/topic/Native-American/The-Arctic
# https://native-land.ca/
NA_data <- st_read("../data/day28_data/northeast_indigenous_peoples.geojson") %>%
st_transform(crs = crs_greatlakes) %>%
mutate(color = c("#6FB382FF", "#AF9699FF", "#92BBD9FF", "#44A57CFF",
"#590514FF", "#06425AFF", "#AD8152FF", "#BBA78CFF",
"#ECE28BFF", "#833437FF", "#E48C2AFF", "#d3a7d4",
"#CEC917FF", "#B50A2AFF", "#E9D097FF", "#E3D1C3FF",
"#F3E8CCFF", "#80C7C9FF"),
name = stringr::str_to_title(name))
# annotations
text_sup <- "L. Superior"
text_ont <- "L. Ontario"
text_mic <- "L. Michigan"
text_hur <- "L. Huron"
text_eri <- "L. Erie"
text_MN <- "MN"
text_MI <- "MI"
text_OH <- "OH"
text_PA <- "PA"
text_NY <- "NY"
text_IA <- "IA"
text_WI <- "WI"
text_IL <- "IL"
text_IN <- "IN"
text_ON <- "ON"
text_QC <- "QC"
text_subtitle <- glue(
"Home to many Native American tribes\n
throughout history, this map shows\n
some of the most prominent groups."
)
# function to get coordinates of centroid of each lake
getLakeCoords <- function(lakename) {
loc <- great_lakes %>%
filter(grepl(lakename, name)) %>%
st_centroid() %>%
st_coordinates()
}
# location for annotations
loc_sup <- getLakeCoords("Sup")
loc_ont <- getLakeCoords("Ont")
loc_mic <- getLakeCoords("Mic")
loc_hur <- getLakeCoords("Hur")
loc_eri <- getLakeCoords("Eri")
loc_MN <- c(450000, 1270000)
loc_MI <- states %>%
filter(postal == "MI") %>%
st_centroid() %>%
st_coordinates()
loc_OH <- c(1041125, 535000)
loc_PA <- c(1426587, 535000)
loc_NY <- c(1450000, 650000)
loc_IA <- c(450000, 609267)
loc_WI <- states %>%
filter(postal == "WI") %>%
st_centroid() %>%
st_coordinates()
loc_IL <- c(520000, 535000)
loc_IN <- c(785505, 535000)
loc_ON <- c(1150000, 1200000)
loc_QC <- c(1600000, 1100000)
loc_subtitle <- c(1370000, 1310000)
# Native American tribe annotations
{
# function to get centroid of NA tribe locations
getNACoords <- function(tribe) {
loc <- NA_data %>%
filter(grepl(tribe, name, ignore.case = T)) %>%
st_centroid() %>%
st_coordinates()
}
loc_ill <- getNACoords("illinois")
loc_neu <- getNACoords("neutral")
loc_iro <- getNACoords("iroquois")
loc_sus <- getNACoords("susquehannock")
loc_erie <- getNACoords("erie")
loc_kic <- getNACoords("kickapoo")
loc_pot <- getNACoords("potawatomi")
loc_mia <- getNACoords("miami")
loc_alg <- getNACoords("algonquin")
loc_ott <- getNACoords("ottawa")
loc_hoc <- getNACoords("ho-chunk")
loc_oji <- getNACoords("ojibwe")
loc_sha <- getNACoords("shawnee")
loc_iow <- getNACoords("ioway")
loc_huron <- getNACoords("huron")
loc_men <- getNACoords("menominee")
loc_sau <- getNACoords("sauk-fox")
loc_pet <- getNACoords("petun")
}
# map
GL_map <- ggplot() +
# surrounding states/provinces
geom_sf(data = states, fill = "#555555", color = "lightgrey") +
geom_sf(data = provinces, fill = "#444444", color = "lightgrey") +
# great lakes
geom_sf(data = great_lakes, fill = "#96dbe3", color = "#96dbe3") +
# NA tribes
geom_sf(data = NA_data, aes(fill = color), alpha = 0.25, color = "transparent") +
# manually defined colors
scale_fill_identity() +
scale_color_identity() +
# set boundaries for map
coord_sf(xlim = c(398512,1700000),
ylim = c(555490,1415721)) +
# annotations
labs(title = "The Great Lakes",
caption = "
30-Day Map Challenge\n
Day 28: Blue Planet\n
Author: Akira Di Sandro\n
Source: RNaturalEarth\n
R Packages used: tidyverse, sf, rnaturalearth, ggplot2, ggtext, glue") +
geom_richtext(aes(x = loc_sup[1], y = loc_sup[2] + 25000, label = text_sup),
size = 14/.pt, color = "#1f7d87", family = "AppleGothic",
fill = NA, label.color = NA) + # lake superior
geom_richtext(aes(x = loc_ont[1], y = loc_ont[2], label = text_ont),
size = 14/.pt, color = "#1f7d87", family = "AppleGothic",
fill = NA, label.color = NA) + # lake ontario
geom_richtext(aes(x = loc_mic[1] - 15000, y = loc_mic[2], label = text_mic, angle = 75),
size = 14/.pt, color = "#1f7d87", family = "AppleGothic",
fill = NA, label.color = NA) + # lake michigan
geom_richtext(aes(x = loc_hur[1], y = loc_hur[2], label = text_hur),
size = 14/.pt, color = "#1f7d87", family = "AppleGothic",
fill = NA, label.color = NA) + # lake huron
geom_richtext(aes(x = loc_eri[1], y = loc_eri[2], label = text_eri),
size = 14/.pt, color = "#1f7d87", family = "AppleGothic",
fill = NA, label.color = NA) + # lake erie
geom_richtext(aes(x = loc_WI[1], y = loc_WI[2], label = text_WI),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # WI
geom_richtext(aes(x = loc_MI[1], y = loc_MI[2], label = text_MI),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # MI
geom_richtext(aes(x = loc_OH[1], y = loc_OH[2], label = text_OH),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # OH
geom_richtext(aes(x = loc_MN[1], y = loc_MN[2], label = text_MN),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # MN
geom_richtext(aes(x = loc_IN[1], y = loc_IN[2], label = text_IN),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # IN
geom_richtext(aes(x = loc_PA[1], y = loc_PA[2], label = text_PA),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # PA
geom_richtext(aes(x = loc_IL[1], y = loc_IL[2], label = text_IL),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # IL
geom_richtext(aes(x = loc_IA[1], y = loc_IA[2], label = text_IA),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # IA
geom_richtext(aes(x = loc_NY[1], y = loc_NY[2], label = text_NY),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # NY
geom_richtext(aes(x = loc_ON[1], y = loc_ON[2], label = text_ON),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # ON
geom_richtext(aes(x = loc_QC[1], y = loc_QC[2], label = text_QC),
size = 10/.pt, color = "darkgrey", family = "AppleGothic",
fill = NA, label.color = NA) + # QC
geom_richtext(aes(x = loc_subtitle[1], y = loc_subtitle[2], label = text_subtitle, hjust = 0),
size = 10/.pt, color = "black", family = "AppleGothic",
fill = NA, label.color = NA) + # subtitle
geom_richtext(aes(x = loc_ill[1] + 90000, y = loc_IL[2], label = NA_data$name[1]),
size = 10/.pt, color = NA_data$color[1], family = "AppleGothic",
fill = NA, label.color = NA) + # illinois
geom_richtext(aes(x = loc_neu[1], y = loc_neu[2], label = NA_data$name[2]),
size = 10/.pt, color = NA_data$color[2], family = "AppleGothic",
fill = NA, label.color = NA) + # neutral
geom_richtext(aes(x = loc_iro[1] - 150000, y = loc_iro[2], label = NA_data$name[3]),
size = 10/.pt, color = NA_data$color[3], family = "AppleGothic",
fill = NA, label.color = NA) + # iroquois
geom_richtext(aes(x = loc_sus[1], y = loc_PA[2] + 25000, label = NA_data$name[4]),
size = 10/.pt, color = NA_data$color[4], family = "AppleGothic",
fill = NA, label.color = NA) + # Susquehannock
geom_richtext(aes(x = loc_erie[1], y = loc_erie[2], label = NA_data$name[5]),
size = 10/.pt, color = NA_data$color[5], family = "AppleGothic",
fill = NA, label.color = NA) + # erie
geom_richtext(aes(x = loc_kic[1], y = loc_kic[2], label = NA_data$name[6]),
size = 10/.pt, color = NA_data$color[6], family = "AppleGothic",
fill = NA, label.color = NA) + # Kickapoo
geom_richtext(aes(x = loc_pot[1], y = loc_pot[2] - 25000, label = NA_data$name[7]),
size = 10/.pt, color = NA_data$color[7], family = "AppleGothic",
fill = NA, label.color = NA) + # Potawatomi
geom_richtext(aes(x = loc_mia[1], y = loc_IN[2], label = NA_data$name[8]),
size = 10/.pt, color = NA_data$color[8], family = "AppleGothic",
fill = NA, label.color = NA) + # Miami
geom_richtext(aes(x = loc_alg[1], y = loc_alg[2], label = NA_data$name[9]),
size = 10/.pt, color = NA_data$color[9], family = "AppleGothic",
fill = NA, label.color = NA) + # Algonquin
geom_richtext(aes(x = loc_ott[1], y = loc_ott[2], label = NA_data$name[10]),
size = 10/.pt, color = NA_data$color[10], family = "AppleGothic",
fill = NA, label.color = NA) + # Ottawa
geom_richtext(aes(x = loc_hoc[1], y = loc_hoc[2], label = NA_data$name[11]),
size = 10/.pt, color = NA_data$color[11], family = "AppleGothic",
fill = NA, label.color = NA) + # Ho-Chunk
geom_richtext(aes(x = loc_oji[1], y = loc_oji[2], label = NA_data$name[12]),
size = 10/.pt, color = NA_data$color[12], family = "AppleGothic",
fill = NA, label.color = NA) + # Ojibwe
# geom_richtext(aes(x = loc_sha[1], y = loc_sha[2], label = NA_data$name[13]),
# size = 10/.pt, color = NA_data$color[13], family = "AppleGothic",
# fill = NA, label.color = NA) + # Shawnee, actually does not appear on map
geom_richtext(aes(x = loc_iow[1] + 200000, y = loc_iow[2], label = NA_data$name[14]),
size = 10/.pt, color = NA_data$color[14], family = "AppleGothic",
fill = NA, label.color = NA) + # Ioway
geom_richtext(aes(x = loc_huron[1], y = loc_huron[2], label = NA_data$name[15]),
size = 10/.pt, color = NA_data$color[15], family = "AppleGothic",
fill = NA, label.color = NA) + # Huron
geom_richtext(aes(x = loc_men[1], y = loc_men[2], label = NA_data$name[16]),
size = 10/.pt, color = NA_data$color[16], family = "AppleGothic",
fill = NA, label.color = NA) + # Menominee
geom_richtext(aes(x = loc_sau[1], y = loc_sau[2] - 25000, label = NA_data$name[17]),
size = 10/.pt, color = NA_data$color[17], family = "AppleGothic",
fill = NA, label.color = NA) + # Sauk-Fox
geom_richtext(aes(x = loc_pet[1], y = loc_pet[2], label = NA_data$name[18]),
size = 10/.pt, color = NA_data$color[18], family = "AppleGothic",
fill = NA, label.color = NA) + # Petun
# theme specifications
theme_void() +
theme(plot.title = element_text(face = "bold",
size = 30,
margin = margin(5, 10, -40, 0),
hjust = 1,
family = "AppleGothic"),
plot.caption = element_text(face = "italic",
size = 5,
hjust = 1,
margin = margin(-40, 5, 0, 0),
lineheight = 0.5,
family = "AppleGothic"))GL_map
Map 10
Day 29 – Overture Maps: Florence Building Classes
For this challenge, I decided to display the different building types in Overture maps’ building dataset of Florence, Italy (my birth city). I simplified the 55 unique building classifications down to 8 simple categories: farm, religious, parking, education, government, commercial, residential, and other.
The code to build this map has been commented out because it creates and HTML of the map and I’ve provided a screenshot of the map already.
# # load overture data
# buildings <- open_dataset('s3://overturemaps-us-west-2/release/2024-05-16-beta.0/theme=buildings')
#
# # define florence bbox
# firenze_bbox <- c(xmin = 11.151786621561394,
# xmax = 11.329452531215946,
# ymin = 43.726914540750485,
# ymax = 43.83359522522425)
#
# # load florence building data
# firenze_buildings <- buildings %>%
# filter(bbox$xmin > firenze_bbox[1],
# bbox$xmax < firenze_bbox[2],
# bbox$ymin > firenze_bbox[3],
# bbox$ymax < firenze_bbox[4]) %>%
# dplyr::select(id, geometry, height, class, min_height, roof_color) %>%
# collect() %>%
# mutate(height = ifelse(is.na(height), 0, height)) %>%
# st_as_sf(crs = 4326) %>%
# mutate(new_class = case_when(class %in% c("church", "chapel", "shrine", "monastery", "religious", "cathedral", "synagogue") ~ "Religious",
# class %in% c("semidetached_house", "residential", "shed", "apartments", "house", "boathouse", "hut", "hangar", "bunker", "allotment_house") ~ "Residential",
# class %in% c("office", "warehouse", "service", "commercial", "retail", "kiosk", "supermarket") ~ "Commercial",
# class == "government" ~ "Government",
# class %in% c("farm", "farm_auxiliary") ~ "Farm",
# class %in% c("school", "kindergarten", "university", "dormitory", "college") ~ "Education",
# class %in% c("garages", "garage", "parking") ~ "Parking",
# .default = "Other"),
# new_class = factor(new_class, levels = c("Farm", "Religious", "Parking", "Education", "Government", "Commercial", "Residential", "Other")))
#
# # mapping building classes
# color_palette <- c("Farm" = "#7FC97F",
# "Religious" = "#BEAED4",
# "Parking" = "#FDC086",
# "Education" = "#FFFF99",
# "Government" = "#386CB0",
# "Commercial" ="#F0027F",
# "Residential" = "#BF5B17",
# "Other" = "#666666")
#
# map <- rdeck(map_style = mapbox_streets(),
# initial_view_state = view_state(
# center = c(11.246800771068502, 43.77943279356716),
# zoom = 12.5,
# bearing = -60,
# pitch = 76
# )) |>
# add_polygon_layer(
# data = firenze_buildings,
# name = "Building Classifications in Firenze, Italia",
# get_polygon = geometry,
# get_elevation = height,
# get_fill_color = scale_color_category(
# col = new_class,
# palette = color_palette,
# legend = T
# ),
# extruded = TRUE,
# opacity = 0.5)
# save map as html
# saveWidget(map, file = "outputs/29-Aki-Overture.html")
Screenshot of Map 10 HTML